home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / mac / LOGIC Apple II 5.25" Library - ProDOS / PRO064.dsk / ADD.INIT.bas < prev    next >
BASIC Source File  |  2012-02-16  |  12KB  |  247 lines
  1. 600  CALL 39169,X$: IF X$ = ""  THEN SX$ = "": RETURN 
  2. 615 SX$ = "": IF  LEN(X$) >30  THEN  FOR J = 1 TO 30:SX$ = SX$ + CHR$( ASC( MID$ (X$,J,1))): NEXT :X$ = SX$:SX$ = "": VTAB 23: PRINT "NOTE - ENTRY HAS BEEN TRUNCATED";: HTAB 1
  3. 630  FOR K = 1 TO  LEN(X$): IF  ASC( MID$ (X$,K,1)) >96  AND  ASC( MID$ (X$,K,1)) <123  THEN SX$ = SX$ + CHR$( ASC( MID$ (X$,K,1)) -32): NEXT K: RETURN 
  4. 640 SX$ = SX$ + MID$ (X$,K,1): NEXT K: RETURN 
  5. 900  HTAB 2: VTAB 23: PRINT " DO YOU WISH TO DELETE THIS DATA ? ";: GET Z$: PRINT Z$;
  6. 910  IF Z$ = "N"  OR Z$ = "n"  THEN  HOME : GOTO 7000
  7. 920  IF Z$ = "Y"  OR Z$ = "y"  THEN  TEXT : GOSUB 1000: GOSUB 18600: RETURN 
  8. 930  GOTO 900
  9. 1000 A$(0) = "":SA$(0) = "":B$(0) = "":SB$(0) = "":C$(0) = "":CC$(0) = "":E$(0) = "": RETURN 
  10. 6000  GOTO 6200
  11. 6100  PRINT  CHR$(24): INVERSE :T = CV -VS: IF A >1  THEN  GOSUB 6160: RETURN 
  12. 6110  GOSUB 6170: RETURN 
  13. 6130  HTAB HT -3: VTAB CV: PRINT " ";:T = CV -VS: IF A >1  THEN  GOSUB 6160: RETURN 
  14. 6140  GOSUB 6170: RETURN 
  15. 6160  HTAB HT: VTAB VS +T: PRINT "(";T +1;")";" ";PM$(M,T +1);: NORMAL : CALL 64668: RETURN 
  16. 6170  HTAB HT: VTAB VS +T: PRINT "("; LEFT$(PM$(M,T +1),A);")";" ";PM$(M,T +1);: NORMAL : CALL 64668: RETURN 
  17. 6200  IF VS < >0  THEN  HTAB 1: VTAB 1: PRINT MS$(M): GOTO 6240
  18. 6220  HOME : PRINT MS$(M):VS =  INT(((18 -MN(M))/2) +6): VTAB VS -3: PRINT PM$(M,0)
  19. 6240 T = 0: FOR J = 1 TO MN(M): IF A >1  THEN  GOSUB 6160: GOTO 6290
  20. 6280  GOSUB 6170
  21. 6290 T = T +1: NEXT J
  22. 6320  IF G(M) >0  AND G(M) <25  THEN  VTAB G(M):CV = G(M): GOTO 6360
  23. 6350  VTAB VS:CV = VS
  24. 6360  GOSUB 6370: GOTO 6760
  25. 6370  HTAB HT -3:
  26. 6400  GOSUB 6100: WAIT  -16384,128:Z$ =  CHR$( PEEK( -16384) -128): POKE  -16368,0
  27. 6450  IF Z$ =  CHR$(27)  THEN CV = 27: RETURN 
  28. 6460  IF Z$ =  CHR$(13)  THEN  RETURN 
  29. 6480  IF Z$ =  CHR$(11)  THEN  GOSUB 6130:CV = CV -1: GOTO 6690
  30. 6490  IF Z$ =  CHR$(21)  THEN  GOSUB 6130:CV = CV -1: GOTO 6690
  31. 6500  IF Z$ =  CHR$(10)  THEN  GOSUB 6130:CV = CV +1: GOTO 6690
  32. 6510  IF Z$ =  CHR$(32)  THEN  GOSUB 6130:CV = CV +1: GOTO 6690
  33. 6520  IF Z$ =  CHR$(08)  THEN  GOSUB 6130:CV = CV +1: GOTO 6690
  34. 6540  GOSUB 6130:
  35. 6550 T = 0: FOR J = 1 TO MN(M): IF Z$ =  LEFT$(PM$(M,J),1)  THEN CV = VS +T: GOSUB 6100: FOR DQ = 1 TO 200: NEXT DQ: RETURN 
  36. 6580  IF Z$ =  CHR$( ASC( LEFT$(PM$(M,J),1)) +32)  THEN  GOTO 6600
  37. 6590  GOTO 6610
  38. 6600  IF  ASC(Z$) >96  AND  ASC(Z$) <123  THEN CV = VS +T: GOSUB 6100: FOR DQ = 1 TO 200: NEXT DQ: RETURN 
  39. 6610  IF A >1  AND  VAL(Z$) = J  THEN CV = VS +T: GOSUB 6100: FOR DQ = 1 TO 200: NEXT DQ: RETURN 
  40. 6620 T = T +1: NEXT J
  41. 6650 CV = VS: VTAB VS: HTAB HT -3: GOTO 6400
  42. 6690  IF CV >(VS +MN(M) -1)  THEN CV = VS
  43. 6700  IF CV <VS  THEN CV = (VS +MN(M) -1)
  44. 6720  VTAB CV: HTAB HT -3: GOTO 6400
  45. 6760  IF M <8  OR M >10  THEN G(M) = CV
  46. 6770  IF CV = 27  THEN  RETURN 
  47. 6780  GOSUB 6130:T = 0: FOR J = VS TO (VS +MN(M) -1):T = T +1: IF CV = J  THEN CV = T
  48. 6790  NEXT J: RETURN 
  49. 7000  HOME : GOSUB 7440:VT = 7:VB = 16:MN(M) = MN(M) -1:T = 0: FOR J = 1 TO MN(M): VTAB 1: HTAB 1: PRINT MS$(M): VTAB 3: HTAB 1: PRINT PM$(M,0);" ";Y: IF A >1  THEN  GOTO 7090
  50. 7080  HTAB HT: VTAB VT +T: PRINT "("; LEFT$(PM$(M,J),1);")";" ";R$(J);: CALL 64668: GOTO 7100
  51. 7090  HTAB HT: VTAB VT +T: PRINT "(";J;")";" ";R$(J);: CALL 64668
  52. 7100 T = T +1: NEXT J: VTAB 13: HTAB 1: PRINT "_______________________________________"
  53. 7160 MN(M) = MN(M) +2:PM$(M,MN(M) -1) = "DELETE THIS DATA":PM$(M,MN(M)) = "ACCEPT CHANGES":T = 0: FOR J = 1 TO MN(M): IF A >1  THEN  GOTO 7210
  54. 7200  HTAB HB: VTAB VB +T: PRINT "("; LEFT$(PM$(M,J),1);")";" ";PM$(M,J): GOTO 7220
  55. 7210  HTAB HB: VTAB VB +T: PRINT "(";J;")";" ";PM$(M,J)
  56. 7220 T = T +1: NEXT J
  57. 7240 VS = VB:TP = HT:HT = HB: GOSUB 6320:HT = TP:MN(M) = MN(M) -2: IF CV = MN(M) +1  THEN  GOSUB 7290: HOME : GOSUB 7470:MN(M) = MN(M) +1: GOSUB 7500: GOTO 900
  58. 7270  IF CV = MN(M) +2  THEN  TEXT : HOME : GOSUB 7470:MN(M) = MN(M) +1: GOSUB 7500: RETURN 
  59. 7280  GOSUB 7290: GOTO 7300
  60. 7290 X = 0:Y2 = 14:DX = 39:DY = 10: & X,Y2,DX,DY: RETURN 
  61. 7300  IF CV = 27  THEN  TEXT : HOME :MN(M) = MN(M) +1: GOSUB 7500: RETURN 
  62. 7305  GOSUB 7360: GOTO 7160
  63. 7360  IF CV >2  THEN  GOTO 7390
  64. 7370  HOME : PRINT : PRINT "ENTER ";PM$(M,CV): PRINT : GOSUB 600: IF X$ =  CHR$(27)  THEN  GOTO 7420
  65. 7380 R$(CV) = X$:R$(CV +MN(M)) = SX$: GOTO 7420
  66. 7390  HOME : PRINT : PRINT "ENTER ";PM$(M,CV): PRINT : GOSUB 600: IF X$ =  CHR$(27)  THEN  GOTO 7420
  67. 7400 R$(CV) = X$
  68. 7420  VTAB (VT +CV -1): HTAB HT: PRINT "("; LEFT$(PM$(M,CV),1);")";" ";R$(CV);: CALL 64668: HOME : RETURN 
  69. 7440 R$(1) = B$(Y):R$(2) = A$(Y):R$(3) = C$(Y):R$(4) = CC$(Y):R$(5) = E$(Y):R$(6) = SB$(Y):R$(7) = SA$(Y)
  70. 7450  IF  LEN(R$(5)) <17  THEN  FOR Q2 =  LEN(R$(5)) +1 TO 17:R$(5) = R$(5) +" ": NEXT Q2
  71. 7455  RETURN 
  72. 7470 B$(Y) = R$(1):A$(Y) = R$(2):C$(Y) = R$(3):CC$(Y) = R$(4):E$(Y) = R$(5):SB$(Y) = R$(6):SA$(Y) = R$(7): RETURN 
  73. 7500 PM$(M,MN(M)) = "TELEPHONE NUMBER": RETURN 
  74. 18000 N2% = N%:N% = 1: HOME : PRINT : PRINT : GOSUB 18500: IF B$(0) < >""  THEN  GOTO 18182
  75. 18015  VTAB 3: HTAB 1: PRINT "PLEASE ENTER THE RETURN ADDRESS": VTAB 1: HTAB 1: PRINT "ESC TO STOP":Y = 0:VT = 7:VB = 16:M = 1:HT = 5:HB = 10: GOSUB 7440
  76. 18030  VTAB 13: HTAB 1: PRINT "_______________________________________": GOSUB 7290
  77. 18060 T = 0: FOR CV = 1 TO MN(M) -1: GOSUB 7360
  78. 18070  IF X$ =  CHR$(27)  THEN  TEXT : HOME : GOSUB 18600: RETURN 
  79. 18080  NEXT CV: GOSUB 7470
  80. 18140  HOME : VTAB 23: HTAB 2: PRINT "DO YOU WISH TO CHANGE ANYTHING ?   ";: GET Z$: IF Z$ < >"Y"  AND Z$ < >"y"  THEN  TEXT : RETURN 
  81. 18160  TEXT : HOME : GOSUB 7000
  82. 18182 T1 =  LEN(A$(0)):T2 = 36 -T1: IF T2 > LEN(B$(0))  THEN T2 =  LEN(B$(0))
  83. 18183  IF T2 = 0  THEN T2 = 1
  84. 18184  HOME : VTAB 8: HTAB 2: PRINT  LEFT$(B$(0),T2);" ";A$(0): HTAB 2: PRINT C$(0): HTAB 2: PRINT CC$(0): VTAB 1: HTAB 1: PRINT "ESC TO STOP"
  85. 18200  VTAB 14: PRINT " USE ABOVE AS THE RETURN ADDRESS ? ";: GET Z$: IF Z$ =  CHR$(27)  THEN  GOSUB 18600: RETURN 
  86. 18210  IF Z$ < >"Y"  AND Z$ < >"y"  THEN  HOME : PRINT : GOTO 18015
  87. 18220 N% = N2%: RETURN 
  88. 18500 A1$ = A$(0):B1$ = B$(0):C1$ = C$(0):C2$ = CC$(0): RETURN 
  89. 18600 A$(0) = A1$:B$(0) = B1$:C$(0) = C1$:CC$(0) = C2$:N% = N2%: RETURN 
  90. 21000 CODE$ = ""
  91. 21003  IF RM% = 1  THEN  RETURN 
  92. 21005  GOTO 21130
  93. 21010 CODE$ = ""
  94. 21020  IF DI = 1  THEN BT = 16 *SI
  95. 21030  IF DI = 2  THEN BT = (16 *SI) +128
  96. 21040  POKE 867,BT
  97. 21050  CALL 870
  98. 21060 PK =  PEEK(850)
  99. 21070 ER = (PK/16 - INT(PK/16)) *16
  100. 21080  IF ER = 0  THEN CODE$ = "ERROR": RETURN 
  101. 21090  FOR I = 851 TO 865
  102. 21100 CODE$ = CODE$ + CHR$( PEEK(I))
  103. 21110  NEXT I
  104. 21120  RETURN 
  105. 21130  FOR DI = 1 TO 2
  106. 21140  FOR SI = 7 TO 1  STEP  -1
  107. 21150  GOSUB 21010
  108. 21160  IF  MID$ (CODE$,1, LEN(VP$)) = VP$  THEN  RETURN 
  109. 21170  NEXT SI
  110. 21180  NEXT DI
  111. 21190 CODE$ = "ERROR"
  112. 21200  VTAB 10: HTAB 7: PRINT "PLEASE INSERT PROGRAM DISK  ": VTAB 12: HTAB 7: PRINT "PRESS A KEY TO CONTINUE  ";: GET Z$
  113. 21210  RETURN 
  114. 22000 J = 0
  115. 22130  FOR DI = 1 TO 2
  116. 22140  FOR SI = 7 TO 1  STEP  -1
  117. 22150  GOSUB 21010
  118. 22160  IF CODE$ = "ERROR"  THEN  GOTO 22170
  119. 22165 J = J +1
  120. 22166 VL$(J) = CODE$
  121. 22170  NEXT SI
  122. 22180  NEXT DI
  123. 22190 JV = J
  124. 22200  FOR J = 1 TO JV
  125. 22205  IF J >5  THEN  GOTO 22300
  126. 22210  VTAB (J +9): HTAB 5: PRINT VL$(J)
  127. 22220  GOTO 22310
  128. 22300  VTAB (J +4): HTAB 20: PRINT VL$(J)
  129. 22310  NEXT J
  130. 22350  GOTO 26110
  131. 23000 VT$ = ""
  132. 23010  FOR J = 2 TO  LEN(Z$)
  133. 23020  IF  MID$ (Z$,J,1) = "/"  THEN J =  LEN(Z$): GOTO 23040
  134. 23030 VT$ = VT$ + MID$ (Z$,J,1)
  135. 23040  NEXT J
  136. 23130  FOR DI = 1 TO 2
  137. 23140  FOR SI = 7 TO 1  STEP  -1
  138. 23150  GOSUB 21010
  139. 23160  IF  MID$ (CODE$,1, LEN(VT$)) = VT$  THEN  RETURN 
  140. 23170  NEXT SI
  141. 23180  NEXT DI
  142. 23190 CODE$ = "ERROR"
  143. 23210  RETURN 
  144. 25000 A = 1:M = 6:HT = 4:VS = 0: HOME 
  145. 25010  GOSUB 6200
  146. 25015  IF CV = 27  AND N% = 1  THEN  HOME : VTAB 5: PRINT "YOUR DEFAULT VALUES HAVE BEEN CHANGED": PRINT "DO YOU WISH TO SAVE THEM TO DISK ? ";: GET Z$: IF Z$ = "Y"  OR Z$ = "y"  THEN  GOTO 25500
  147. 25016  IF CV = 27  THEN N% = 0: HOME : GOTO 25610
  148. 25020  ON CV GOTO 25022,25200,25400,25500
  149. 25022 A = 1:M = 11:HT = 4:VS = 0: HOME : GOSUB 6200
  150. 25024  IF CV = 27  THEN  GOTO 25000
  151. 25025  ON CV GOTO 25030,26000
  152. 25030 TS = 0:TD = 0
  153. 25040  HOME : HTAB 1: VTAB 1: PRINT "ESC TO CANCEL": PRINT : PRINT "RETURN TO ACCEPT"
  154. 25050  VTAB 10: HTAB 9: PRINT "SLOT FOR DATA DISK : ";: IF TS = 0  THEN  PRINT SL: GOTO 25070
  155. 25060  PRINT TS
  156. 25070  VTAB 10: HTAB 30: GET Z$: PRINT Z$
  157. 25080  IF Z$ =  CHR$(27)  THEN  GOTO 25000
  158. 25090  IF Z$ =  CHR$(13)  AND TS = 0  THEN Z$ =  STR$(SL): GOTO 25100
  159. 25092  IF Z$ =  CHR$(13)  THEN Z$ =  STR$(TS): GOTO 25100
  160. 25095  IF  VAL(Z$) <1  OR  VAL(Z$) >7  THEN  GOTO 25050
  161. 25100 TS =  VAL(Z$): VTAB 10: HTAB 29: PRINT " ";TS
  162. 25110  VTAB 12: HTAB 9: PRINT "DRIVE FOR DATA DISK : ";: IF TD = 0  THEN  PRINT DR: GOTO 25130
  163. 25120  PRINT TD
  164. 25130  VTAB 12: HTAB 31: GET Z$: PRINT Z$
  165. 25140  IF Z$ =  CHR$(27)  THEN  GOTO 25000
  166. 25150  IF Z$ =  CHR$(13)  AND TD = 0  THEN Z$ =  STR$(DR): GOTO 25160
  167. 25152  IF Z$ =  CHR$(13)  THEN Z$ =  STR$(TD): GOTO 25160
  168. 25155  IF  VAL(Z$) <1  OR  VAL(Z$) >2  THEN  GOTO 25110
  169. 25160 TD =  VAL(Z$): VTAB 12: HTAB 30: PRINT " ";TD
  170. 25170  VTAB 15: HTAB 9: PRINT "IS THIS CORRECT ? (Y/N) ";: GET Z$: PRINT Z$
  171. 25173 N2% = N%
  172. 25175  IF SL < >TS  THEN N% = 1
  173. 25176  IF DR < >TD  THEN N% = 1
  174. 25180  IF Z$ = "Y"  OR Z$ = "y"  THEN SL = TS:DR = TD: GOTO 25000
  175. 25185 N% = N2%
  176. 25190  GOTO 25050
  177. 25200 TC$ = ""
  178. 25210  HOME : HTAB 1: VTAB 1: PRINT "ESC TO CANCEL": PRINT : PRINT "RETURN TO ACCEPT"
  179. 25220  VTAB 10: HTAB 9: PRINT "DEFAULT AREA CODE : ";: IF TC$ = ""  THEN  PRINT AC$;: CALL 64668: GOTO 25240
  180. 25230  PRINT TC$;: CALL 64668
  181. 25240  VTAB 10: HTAB 29: FOR J = 1 TO 3: GET Z$: PRINT Z$;: CALL 64668
  182. 25250  IF Z$ =  CHR$(27)  THEN  GOTO 25000
  183. 25260  IF Z$ =  CHR$(13)  AND TC$ = ""  THEN TC$ = AC$: GOTO 25290
  184. 25265  IF Z$ =  CHR$(13)  THEN  GOTO 25290
  185. 25270  IF  ASC(Z$) <48  OR  ASC(Z$) >57  THEN  GOTO 25240
  186. 25275  IF J = 1  THEN TC$ = ""
  187. 25280 TC$ = TC$ +Z$: NEXT J
  188. 25290  VTAB 10: HTAB 29: PRINT TC$;: CALL 64668
  189. 25300  VTAB 13: HTAB 9: PRINT "IS THIS CORRECT ? (Y/N) ";: GET Z$
  190. 25302 N2% = N%
  191. 25305  IF AC$ < >TC$  THEN N% = 1
  192. 25310  IF Z$ = "Y"  OR Z$ = "y"  THEN AC$ = TC$: GOTO 25000
  193. 25315 N% = N2%
  194. 25320  GOTO 25220
  195. 25400  GOSUB 18000: GOTO 25000
  196. 25500  HOME : VTAB 10: HTAB 9: PRINT "ESC TO RETURN TO MENU"
  197. 25510  VTAB 12: HTAB 12: PRINT "RETURN TO SAVE  ";: GET Z$
  198. 25530  IF Z$ =  CHR$(27)  THEN  GOTO 25000
  199. 25535 N% = 0
  200. 25540 WA$ = PR$ +"SETUP/ADD.SETUP"
  201. 25550 D$ =  CHR$(4)
  202. 25555  HOME : GOSUB 21000: IF CODE$ = "ERROR"  THEN  GOTO 25555
  203. 25560  PRINT D$;"OPEN ";WA$
  204. 25570  PRINT D$;"WRITE ";WA$
  205. 25580  PRINT SL: PRINT DR: PRINT AC$
  206. 25590  PRINT A$(0): PRINT B$(0): PRINT C$(0): PRINT CC$(0): PRINT PD$
  207. 25600  PRINT D$;"CLOSE ";WA$
  208. 25605 WA$ = ""
  209. 25610  IF DR <1  THEN DR = 1
  210. 25615  IF SL <1  THEN SL = 6
  211. 25620  HOME 
  212. 25630  PRINT D$;"CHAIN ADD.ENTER,@32000"
  213. 26000  REM            PREFIX - UNDER CONSTRUCTION 
  214. 26020  HOME 
  215. 26030  VTAB 12: PRINT "CURRENT PREFIX :  ": PRINT PD$
  216. 26040  VTAB 15: PRINT "KEEP CURRENT PREFIX ? (Y/N)  :";: GET Z$
  217. 26050  IF (Z$ = "N")  OR (Z$ = "n")  THEN  GOTO 26060
  218. 26052 SL = 8:DR = 3
  219. 26054  GOTO 25000
  220. 26060  HOME 
  221. 26061  PRINT "Q TO QUIT / RETURN TO ACCEPT"
  222. 26062  PRINT "V TO SEE DISKS CURRENTLY AVAILABLE"
  223. 26070  VTAB 5: HTAB 1: PRINT "LAST PREFIX USED :"
  224. 26080  VTAB 6: HTAB 1: PRINT PD$
  225. 26100  VTAB 19: PRINT "ENTER COMPLETE PREFIX (ALL CAPS) : "
  226. 26105  VTAB 20: PRINT "DATA DISK MUST BE IN A DRIVE"
  227. 26110  VTAB 22: INPUT "";Z$
  228. 26120  IF Z$ = "Q" GOTO 25022
  229. 26130  IF Z$ = "q" GOTO 25022
  230. 26140  IF (Z$ = "V")  OR (Z$ = "v")  THEN  GOTO 22000
  231. 26160  IF  LEN(Z$) <2  THEN  PRINT : PRINT : PRINT : PRINT "LENGTH OF NAME MUST BE GREATER THAN 1";: CALL 64668: GET Z$: GOTO 26020
  232. 26170  IF  ASC(Z$) >90  AND  ASC(Z$) <97  THEN  GOTO 26200
  233. 26180  IF  ASC(Z$) <65  OR  ASC(Z$) >122  THEN  GOTO 26195
  234. 26190  GOTO 26220
  235. 26195  IF  ASC(Z$) < >47  THEN  GOTO 26200
  236. 26196  GOTO 26220
  237. 26200  PRINT : PRINT : PRINT : PRINT "FILE NAME MUST BEGIN WITH A LETTER ";: CALL 64668: PRINT 
  238. 26210  PRINT : PRINT "PLEASE DO NOT USE CHARACTERS OTHER THAN";: CALL 64668: PRINT : PRINT :: PRINT "LETTERS,NUMBERS OR PERIODS";: CALL 64668: GET Z$: GOTO 26020
  239. 26220  IF  LEFT$(Z$,1) < >"/"  THEN Z$ = "/" +Z$
  240. 26221  GOSUB 23000
  241. 26222  IF CODE$ = "ERROR"  THEN  HOME : VTAB 10: PRINT "PLEASE INSERT YOUR DATA DISK": PRINT "INTO AN AVAILABLE DRIVE AND TRY AGAIN  ";: GET Z$: GOTO 26020
  242. 26225 PD$ = Z$
  243. 26230  IF  MID$ (PD$, LEN(PD$),1) < >"/"  THEN PD$ = PD$ +"/"
  244. 26240 SL = 8:DR = 3
  245. 26260  GOTO 25000
  246. 40000  PRINT  CHR$(4);"SAVE /RAM/ADD.INIT"
  247. 40100  PRINT  CHR$(4);"CHAIN ADD.ENTER,@40000"